home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Software Vault: The Gold Collection
/
Software Vault - The Gold Collection (American Databankers) (1993).ISO
/
cdr09
/
famprint.zip
/
FAMPRINT.BAS
next >
Wrap
BASIC Source File
|
1993-06-09
|
21KB
|
719 lines
'
'***************************************************************************
'* *
'* FamPrint - Family Print *
'* by Kent Riggins *
'* Sept 1989 *
'* *
'* You Must start QuickBasic with the /AH Option *
'* *
'* *
'***************************************************************************
DECLARE SUB DoParents (VP AS INTEGER)
DECLARE SUB ConnectFamily (Start AS INTEGER, Finish AS INTEGER)
DECLARE SUB DoSpouses (VP AS INTEGER)
DECLARE SUB ConnectSpouses (Start AS INTEGER, Last AS INTEGER)
DECLARE SUB PrintLI (VP%)
DECLARE SUB MakeName (RCD AS INTEGER, Nam AS STRING)
DECLARE SUB PrintIt ()
DECLARE SUB GenFam (RCD%, GenVar%)
DECLARE SUB FindChildren (Child%)
DECLARE SUB SortInd ()
DECLARE SUB PrintAll ()
DECLARE SUB ConvertDate (a$, year%, month%, day%, MODIFIER%, DYEAR%)
DECLARE FUNCTION G2JD& (year%, month%, day%)
DECLARE SUB Push (Dat%)
DECLARE SUB Pop (Dat%)
DECLARE SUB GetName (NAMERCD%, Name$)
PRINT " ╔═══════════════════════════════════════════════════════╗ "
PRINT " ║ FAMPRINT ║ "
PRINT " ║ PAF to BIG Wall Chart ║ "
PRINT " ║ (C) Copyright 1989 by Kent Riggins ║ "
PRINT " ╚═══════════════════════════════════════════════════════╝ "
PRINT
PRINT " ┌─────────────────────────────────────────────────────────────┐"
PRINT " │ This program is in its first iteration.... I know │"
PRINT " │everything does not work correctly, but it is getting there. │"
PRINT " │ │"
PRINT " │ This program prints a linked chart of everyone in your PAF │"
PRINT " │database. One problem is that if your database is too big │"
PRINT " │for any one generation, it blows up.... another is that not │"
PRINT " │all the connecting lines are properly routed.... but like I │"
PRINT " │said above I am working on it...... │"
PRINT " └─────────────────────────────────────────────────────────────┘"
TYPE NameRecord
NLLINK AS INTEGER
NNAME AS STRING * 17
NRLINK AS INTEGER
END TYPE
TYPE BNameRecord
NAMEMAX AS STRING * 11
NFIRSTDELET AS STRING * 10
END TYPE
TYPE MarrRecord
MHusPtr AS INTEGER
MWifPtr AS INTEGER
MChildPtr AS INTEGER
MarrDT AS STRING * 4
MPL1 AS INTEGER
MPL2 AS INTEGER
MPL3 AS INTEGER
MPL4 AS INTEGER
MWifToHusSealDT AS STRING * 3
MWifToHusSealTemp AS INTEGER
MHusOtherMarrPtr AS INTEGER
MWifOtherMarrPtr AS INTEGER
END TYPE
TYPE BMarrRecord
MarrMAX AS STRING * 11
MarrFIRSTDELET AS STRING * 10
XXXX AS STRING * 7
END TYPE
TYPE IndiRecord
ISUR AS INTEGER
IG1 AS INTEGER
IG2 AS INTEGER
IG3 AS INTEGER
ITITLE AS INTEGER
ISEX AS STRING * 1
IBDT AS STRING * 4
IBP1 AS INTEGER
IBP2 AS INTEGER
IBP3 AS INTEGER
IBP4 AS INTEGER
ICHD AS STRING * 4
ICP1 AS INTEGER
ICP2 AS INTEGER
ICP3 AS INTEGER
ICP4 AS INTEGER
IDD AS STRING * 4
IDP1 AS INTEGER
IDP2 AS INTEGER
IDP3 AS INTEGER
IDP4 AS INTEGER
IBUD AS STRING * 4
IBU1 AS INTEGER
IBU2 AS INTEGER
IBU3 AS INTEGER
IBU4 AS INTEGER
IBAPD AS STRING * 3
IBAPT AS INTEGER
IEDD AS STRING * 3
IEDT AS INTEGER
ICTPSD AS STRING * 3
ICTPST AS INTEGER
IOSP AS INTEGER
IOMP AS INTEGER
IPMP AS INTEGER
IIDNUM AS STRING * 10
INPADP AS INTEGER
END TYPE
TYPE BIndiRecord
INDIVIDMAX AS STRING * 11
IFIRSTDELET AS STRING * 10
XXXX AS STRING * 71
END TYPE
TYPE Location
Index AS STRING * 14
Gen AS INTEGER 'also used as Row
Fam AS INTEGER 'also used as Column
Birth AS DOUBLE 'also used as Line
SiblingCheck AS STRING * 1
RCD AS INTEGER
ParentFam AS INTEGER
Processed AS STRING * 1
END TYPE
TYPE Pline
LRcd AS INTEGER
COL AS STRING * 50
RRcd AS INTEGER
FamCon AS STRING * 1
END TYPE
DIM SHARED Head AS INTEGER, Tail AS INTEGER, LFMT AS STRING
LFMT = "\ \\ \\\"
CurrentGen% = 5
REM $DYNAMIC
DIM SHARED IND(0 TO 2000) AS Location
DIM SHARED Stack%(1000), FamNum%(30)
DIM SHARED LI(1 TO 2000) AS Pline
DIM SHARED IPTR(2000) AS INTEGER
DIM NameR AS NameRecord, BName AS BNameRecord
DIM CIndi AS IndiRecord, Tindi AS IndiRecord, BIndi AS BIndiRecord
DIM Marr AS MarrRecord, TMarr AS MarrRecord, BMarr AS BMarrRecord
INPUT " Enter path for input: ", fp$
INPUT " Enter path and file for output: ", outfile$
OPEN fp$ + "name2.dat" FOR RANDOM AS #1 LEN = 21
OPEN fp$ + "indiv2.dat" FOR RANDOM AS #2 LEN = 92
OPEN fp$ + "MARR2.DAT" FOR RANDOM AS #3 LEN = 28
OPEN outfile$ FOR OUTPUT AS #8
GET #3, 1, BMarr
MarrMAX% = VAL(MarrMAX$)
GET #2, 1, BIndi
INDIVIDMAX% = VAL(BIndi.INDIVIDMAX)
Main:
GOSUB Search
PRINT "There are "; INDIVIDMAX%; " people in the individual file."
PRINT " and "; TotalCount; " Where found!"
SortInd
PrintIt
CLOSE ALL
END
Search:
CLS
PRINT
PRINT "Enter Starting RIN:";
INPUT StartRIN%
CALL Push(StartRIN%)
CLS
PRINT "There are "; INDIVIDMAX%; " people in the individual file."
PRINT "This may take a While...."
Done% = 1
CurrentGen% = 5
TotalCount = 0
CLS
PRINT "Searching "
DO WHILE (Done% <> 0)
CALL Pop(CurrentIndi%)
IF CurrentIndi% < 1 THEN
Done% = 0
EXIT DO
END IF
IF IND(CurrentIndi%).Processed = "Y" THEN GOTO Bottom
IND(CurrentIndi%).RCD = CurrentIndi%
LOCATE 3, 1
PRINT CurrentIndi%; " "
TotalCount = TotalCount + 1
GET #2, (CurrentIndi% + 1), CIndi
IND(CurrentIndi%).Processed = "Y"
CALL GenFam(CurrentIndi%, 0)
CurrentGen% = IND(CurrentIndi%).Gen
CALL ConvertDate(CIndi.IBDT, year%, month%, day%, MODIFIER%, DYEAR%)
IND(CurrentIndi%).Birth = G2JD&(year%, month%, day%)
' Find all Spouses
IF CIndi.IOMP > 0 THEN
GET #3, (CIndi.IOMP + 1), Marr
IF CIndi.ISEX = "M" THEN
CALL GenFam(Marr.MWifPtr, 0)
CALL Push(Marr.MWifPtr)
CALL FindChildren(Marr.MChildPtr)
DO WHILE (Marr.MHusOtherMarrPtr > 0)
GET #3, (Marr.MHusOtherMarrPtr + 1), Marr
CALL GenFam(Marr.MWifPtr, 0)
CALL Push(Marr.MWifPtr)
CALL FindChildren(Marr.MChildPtr)
LOOP
ELSE
CALL GenFam(Marr.MHusPtr, 0)
CALL Push(Marr.MHusPtr)
CALL FindChildren(Marr.MChildPtr)
DO WHILE (Marr.MWifOtherMarrPtr > 0)
GET #3, (Marr.MWifOtherMarrPtr + 1), Marr
CALL GenFam(Marr.MHusPtr, 0)
CALL Push(Marr.MHusPtr)
CALL FindChildren(Marr.MChildPtr)
LOOP
END IF
END IF
' Find parents
IF CIndi.IPMP > 0 THEN
GET #3, (CIndi.IPMP + 1), TMarr
' Do Father
CALL GenFam(TMarr.MHusPtr, 1)
IF TMarr.MHusPtr > 0 THEN
IND(CurrentIndi%).ParentFam = IND(TMarr.MHusPtr).Fam
ELSE
IF TMarr.MWifPtr > 0 THEN
IND(CurrentIndi%).ParentFam = IND(TMarr.MWifPtr).Fam
END IF
END IF
CALL Push(TMarr.MHusPtr)
' Do Mother
CALL GenFam(TMarr.MWifPtr, 1)
CALL Push(TMarr.MWifPtr)
' Find Brothers and sisters
IF IND(CurrentIndi%).SiblingCheck = "N" THEN
IND(CurrentIndi%).SiblingCheck = "Y"
Child% = TMarr.MChildPtr
GET #2, (Child% + 1), Tindi
DO WHILE (Child% > 0)
IND(Child%).Gen = IND(CurrentIndi%).Gen
IND(Child%).Fam = IND(CurrentIndi%).Fam
IND(Child%).SiblingCheck = "Y"
CALL Push(Child%)
Child% = Tindi.IOSP
IF Child% > 0 THEN
GET #2, (Child% + 1), Tindi
ELSE
EXIT DO
END IF
LOOP
END IF
END IF
Bottom:
LOOP
RETURN
REM $STATIC
SUB ConnectFamily (Start AS INTEGER, Finish AS INTEGER)
DIM dir AS INTEGER
StartLI = IND(Start).Birth 'Start Line
EndLI = IND(Finish).Gen 'End Line
EndCol = IND(Finish).Fam 'End Column
MID$(LI(StartLI).COL, 1, 1) = "─" '196
COL = 2
DO WHILE (MID$(LI(StartLI).COL, COL, 1) <> " " AND COL < 50)
IF MID$(LI(StartLI).COL, COL, 1) = "│" THEN '179
MID$(LI(StartLI).COL, COL, 1) = "┼" '197
END IF
MID$(LI(StartLI).COL, COL + 1, 1) = "─" '196
COL = COL + 2
LOOP
IF StartLI < EndLI THEN
dir = 1
MID$(LI(StartLI).COL, COL, 1) = "┐" '191
ELSE
MID$(LI(StartLI).COL, COL, 1) = "┘" '217
dir = -1
END IF
FOR L = (StartLI + dir) TO EndLI STEP dir
SELECT CASE MID$(LI(L).COL, COL, 1)
CASE " "
MID$(LI(L).COL, COL, 1) = "│" '179
CASE "─" '196
MID$(LI(L).COL, COL, 1) = "┼" '197
CASE ELSE
IF dir < 0 THEN ' ie going up
MID$(LI(L + 1).COL, COL, 1) = "┌" '218
DoneUp = 1
DO WHILE (DoneUp = 1)
COL = COL + 1
MID$(LI(L + 1).COL, COL, 1) = "─" '196
IF MID$(LI(L).COL, COL, 1) = "─" THEN '179
MID$(LI(L + 1).COL, COL, 1) = "┘" '217
MID$(LI(L).COL, COL, 1) = "┼" '197
DoneUp = 0
EXIT DO
END IF
IF MID$(LI(L).COL, COL, 1) = " " THEN '179
MID$(LI(L + 1).COL, COL, 1) = "┘" '217
MID$(LI(L).COL, COL, 1) = "│" '179
DoneUp = 0
EXIT DO
END IF
LOOP
ELSE ' going down
MID$(LI(L - 1).COL, COL, 1) = "└" '192
DoneUp = 1
DO WHILE (DoneUp = 1)
COL = COL + 1
MID$(LI(L - 1).COL, COL, 1) = "─" '196
IF MID$(LI(L).COL, COL, 1) = "─" THEN '179
MID$(LI(L - 1).COL, COL, 1) = "┐" '191
MID$(LI(L).COL, COL, 1) = "┼" '197
DoneUp = 0
EXIT DO
END IF
IF MID$(LI(L).COL, COL, 1) = " " THEN '179
MID$(LI(L - 1).COL, COL, 1) = "┐" '191
MID$(LI(L).COL, COL, 1) = "│" '179
DoneUp = 0
EXIT DO
END IF
LOOP
END IF
END SELECT
NEXT L
IF StartLI < EndLI THEN
MID$(LI(EndLI).COL, COL, 1) = "└" '192
ELSE
MID$(LI(EndLI).COL, COL, 1) = "┌" '218
END IF
FOR C = (COL + 1) TO (EndCol - 1)
IF MID$(LI(EndLI).COL, C, 1) = "│" THEN '179
MID$(LI(EndLI).COL, C, 1) = "┼" '197
ELSE
MID$(LI(EndLI).COL, C, 1) = "─" '196
END IF
NEXT C
IF MID$(LI(EndLI).COL, EndCol, 1) = "┌" THEN ' 218
MID$(LI(EndLI).COL, EndCol, 1) = "┬" '194
ELSE
IF MID$(LI(EndLI).COL, EndCol, 1) = "└" THEN ' 192
MID$(LI(EndLI).COL, EndCol, 1) = "┴" '193
ELSE
MID$(LI(EndLI).COL, EndCol, 1) = "─" '196
END IF
END IF
1
END SUB
SUB ConnectSpouses (Start AS INTEGER, Last AS INTEGER) STATIC
StartLI = IND(Start).Birth ' Line Person is ON
EndLI = IND(Last).Birth ' Line Person is ON
IF StartLI < EndLI THEN
MID$(LI(StartLI).COL, 50, 1) = "─" '196
MID$(LI(EndLI).COL, 50, 1) = "─" '196
COL = 49
DO WHILE (MID$(LI(StartLI).COL, COL, 1) <> " " AND COL > 1)
IF MID$(LI(StartLI).COL, COL, 1) = "│" THEN '179
MID$(LI(StartLI).COL, COL, 1) = "┼" '197
END IF
MID$(LI(StartLI).COL, COL - 1, 1) = "─" '196
COL = COL - 2
LOOP
MID$(LI(StartLI).COL, COL, 1) = "┌" '218
IND(Start).Gen = StartLI ' Row
IND(Start).Fam = COL ' Column
IND(Last).Gen = StartLI ' Row
IND(Last).Fam = COL ' Column
FOR L = (StartLI + 1) TO EndLI - 1
MID$(LI(L).COL, COL, 1) = "│" '179
NEXT L
MID$(LI(EndLI).COL, COL, 1) = "└" '192
FOR C = (COL + 1) TO 49
IF MID$(LI(EndLI).COL, C, 1) = "│" THEN '179
MID$(LI(EndLI).COL, C, 1) = "┼" '197
ELSE
MID$(LI(EndLI).COL, C, 1) = "─" '196
END IF
NEXT C
END IF
END SUB
SUB ConvertDate (a$, year%, month%, day%, MODIFIER%, DYEAR%) STATIC
a1 = ASC(LEFT$(a$, 1))
a2 = ASC(MID$(a$, 2, 1))
a3 = ASC(MID$(a$, 3, 1))
a4 = ASC(MID$(a$, 4, 1))
year% = a1 * 16 + INT(a2 / 16)
month% = (a2 - INT(a2 / 16) * 16) * 2 + INT(a3 / 128)
day% = INT((a3 - INT(a3 / 128) * 128) / 4)
MODIFIER% = a3 - INT(a3 / 4) * 4
IF a4 = 0 THEN
DYEAR% = 0
ELSE
DYEAR% = year% + a4
END IF
END SUB
SUB DoParents (VP AS INTEGER) STATIC
DIM Indi AS IndiRecord, Marr AS MarrRecord
DIM I AS INTEGER
DIM Start AS INTEGER, Finish AS INTEGER
I = 1
DO WHILE (I < VP + 2)
Start = LI(I).LRcd
IF Start > 0 THEN
GET #2, (Start + 1), Indi
IF Indi.IPMP > 0 THEN
GET #3, (Indi.IPMP + 1), Marr
IF Marr.MWifPtr > 0 THEN
Finish = Marr.MWifPtr
ELSE
Finish = Marr.MHusPtr
END IF
CALL ConnectFamily(Start, Finish)
END IF
DO WHILE (LI(I).LRcd <> 0)
I = I + 1
LOOP
END IF
I = I + 1
LOOP
END SUB
SUB DoSpouses (VP AS INTEGER) STATIC
DIM Indi AS IndiRecord, Marr AS MarrRecord
DIM CurrentIndi AS INTEGER
FOR X = 1 TO VP
CurrentIndi = LI(X).RRcd
GET #2, (CurrentIndi + 1), Indi
' Find all Spouses
IF Indi.IOMP > 0 THEN
GET #3, (Indi.IOMP + 1), Marr
IF Indi.ISEX = "M" THEN
CALL ConnectSpouses(CurrentIndi, Marr.MWifPtr)
DO WHILE (Marr.MHusOtherMarrPtr > 0)
GET #3, (Marr.MHusOtherMarrPtr + 1), Marr
CALL ConnectSpouses(CurrentIndi, Marr.MWifPtr)
LOOP
ELSE
CALL ConnectSpouses(CurrentIndi, Marr.MHusPtr)
DO WHILE (Marr.MWifOtherMarrPtr > 0)
GET #3, (Marr.MWifOtherMarrPtr + 1), Marr
CALL ConnectSpouses(CurrentIndi, Marr.MHusPtr)
LOOP
END IF
ELSE
IND(CurrentIndi).Gen = X ' Row
IND(Start).Fam = 49 ' Column
END IF
NEXT X
END SUB
SUB FindChildren (Child%) STATIC
SHARED IND() AS Location
SHARED PTR%
DIM Tindi AS IndiRecord
IF Child% > 0 THEN
CALL GenFam(Child%, -1)
GenAll% = IND(Child%).Gen
FamAll% = IND(Child%).Fam
GET #2, (Child% + 1), Tindi
DO WHILE (Child% > 0)
IND(Child%).SiblingCheck = "Y"
IND(Child%).Gen = GenAll%
IND(Child%).Fam = FamAll%
CALL Push(Child%)
Child% = Tindi.IOSP
IF Child% > 0 THEN
GET #2, (Child% + 1), Tindi
ELSE
EXIT DO
END IF
LOOP
END IF
END SUB
FUNCTION G2JD& (year%, month%, day%)
T& = FIX((month% - 14) / 12)
G2JD& = day% - 32075 + INT(1461 * (year% + 4800 + T&) / 4) + INT(367 * (month% - 2 - T& * 12) / 12) - INT(3 * INT((year% + 4900 + T&) / 100) / 4)
END FUNCTION
SUB GenFam (RCD%, GenVar%) STATIC
SHARED IND() AS Location
SHARED FamNum%()
SHARED CurrentGen%
IF RCD% > 0 THEN
IF IND(RCD%).Gen = 0 THEN
IND(RCD%).Gen = CurrentGen% + GenVar%
END IF
IF IND(RCD%).Fam = 0 THEN
FamNum%(IND(RCD%).Gen) = FamNum%(IND(RCD%).Gen) + 1
IND(RCD%).Fam = FamNum%(IND(RCD%).Gen)
END IF
END IF
END SUB
SUB GetName (NAMERCD%, Name$) STATIC
SHARED NameR AS NameRecord
IF NAMERCD% > 0 THEN
GET #1, (NAMERCD% + 1), NameR
Name$ = NameR.NNAME
lg% = INSTR(Name$, CHR$(0)) - 1
Name$ = LEFT$(Name$, lg%)
Name$ = Name$ + " "
ELSE
Name$ = ""
END IF
END SUB
SUB MakeName (RCD AS INTEGER, Nam AS STRING) STATIC
DIM Indi AS IndiRecord
IF RCD > 0 THEN
GET #2, (RCD + 1), Indi
CALL GetName(Indi.ISUR, Surname$)
CALL GetName(Indi.IG1, Name1$)
CALL GetName(Indi.IG2, Name2$)
CALL GetName(Indi.IG3, Name3$)
Nam = RTRIM$(Surname$) + ", " + Name1$ + Name2$ + Name3$
ELSE
Nam = " "
END IF
END SUB
SUB Pop (Dat%) STATIC
Dat% = Stack%(Tail)
IF Head = Tail THEN
Dat% = 0
END IF
Tail = Tail + 1
IF Tail > 1000 THEN
Tail = 0
END IF
END SUB
SUB PrintIt STATIC
SHARED TotalCount
'first Pass
Done = 1
DO WHILE (Done = 1)
CurrentIndi = 1
Oldfam = IND(IPTR(CurrentIndi)).Fam
Oldgen = IND(IPTR(CurrentIndi)).Gen
FOR VP% = 1 TO 2000
IF Oldfam = IND(IPTR(CurrentIndi)).Fam THEN
IND(IPTR(CurrentIndi)).Birth = VP%
LI(VP%).RRcd = IPTR(CurrentIndi)
LI(VP%).FamCon = "│" '179
CurrentIndi = CurrentIndi + 1
ELSE
Oldfam = IND(IPTR(CurrentIndi)).Fam
LI(VP%).RRcd = 0
LI(VP%).FamCon = " "
END IF
LI(VP%).LRcd = 0
LI(VP%).COL = SPACE$(50)
IF Oldgen <> IND(IPTR(CurrentIndi)).Gen THEN
Oldgen = IND(IPTR(CurrentIndi)).Gen
Done = 0
EXIT DO
END IF
NEXT VP%
LOOP
CALL DoSpouses(VP%)
CALL PrintLI(VP%)
'PRINT "press a Key"
'DO
'LOOP WHILE INKEY$ = ""
'PRINT "OK"
'The Rest off the Generations
DO WHILE (CurrentIndi <= TotalCount)
Done = 1
DO WHILE (Done = 1)
OldVP% = VP%
FOR VN% = 1 TO VP% + 1
LI(VN%).LRcd = LI(VN%).RRcd
LI(VN%).RRcd = 0
LI(VN%).COL = SPACE$(50)
LI(VN%).FamCon = " "
NEXT VN%
FOR VN% = VP% TO 2000
LI(VN%).LRcd = 0
LI(VN%).RRcd = 0
LI(VN%).COL = SPACE$(50)
LI(VN%).FamCon = " "
NEXT VN%
FOR VP% = 1 TO 2000
IF Oldfam = IND(IPTR(CurrentIndi)).Fam THEN
IND(IPTR(CurrentIndi)).Birth = VP%
LI(VP%).RRcd = IPTR(CurrentIndi)
LI(VP%).FamCon = "│" '179
CurrentIndi = CurrentIndi + 1
ELSE
Oldfam = IND(IPTR(CurrentIndi)).Fam
LI(VP%).RRcd = 0
LI(VP%).FamCon = " "
END IF
LI(VP%).COL = SPACE$(50)
IF Oldgen <> IND(IPTR(CurrentIndi)).Gen THEN
Oldgen = IND(IPTR(CurrentIndi)).Gen
Done = 0
EXIT DO
END IF
NEXT VP%
LOOP
CALL DoSpouses(VP%)
CALL DoParents(OldVP%)
IF OldVP% > VP% THEN
MaxVP% = OldVP%
ELSE
MaxVP% = VP%
END IF
CALL PrintLI(MaxVP%)
' PRINT "press a Key"
' DO
' LOOP WHILE INKEY$ = ""
' PRINT "OK"
LOOP
END SUB
SUB PrintLI (VP%) STATIC
'lprint CHR$(12)
PRINT #8, "=============================================================================="
FOR X = 1 TO VP%
CALL MakeName(LI(X).RRcd, Rname$)
PRINT #8, USING LFMT; LI(X).COL; Rname$; LI(X).FamCon
NEXT X
END SUB
SUB Push (Dat%) STATIC
IF Dat% > 0 THEN
IF IND(Dat%).Processed <> "Y" THEN
Stack%(Head) = Dat%
Head = Head + 1
IF Head > 1000 THEN Head = 0
IF Head = Tail THEN
PRINT "Head Caught Tail - Increase Stack Size "
STOP
END IF
END IF
END IF
END SUB
SUB SortInd STATIC
SHARED IND() AS Location, TotalCount, IPTR() AS INTEGER
First% = 1
DO WHILE (FamNum%(First%) = 0)
First% = First% + 1
LOOP
First% = First% - 1
CLS
PRINT "Building Keys..."
FOR X% = 1 TO TotalCount
IND(X%).Gen = IND(X%).Gen - First%
MID$(IND(X%).Index, 1, 2) = RIGHT$("000" + LTRIM$(STR$(IND(X%).Gen)), 2)
MID$(IND(X%).Index, 3, 3) = RIGHT$("000" + LTRIM$(STR$(IND(X%).Fam)), 3)
MID$(IND(X%).Index, 6, 7) = RIGHT$("000" + LTRIM$(STR$(IND(X%).Birth)), 7)
IPTR(X%) = X%
NEXT X%
CLS
PRINT "Sorting 1st group"
Offset = TotalCount \ 2
DO WHILE Offset > 0
Limit = TotalCount - Offset
DO
Switch = 0
FOR I = 1 TO Limit
IF IND(IPTR(I)).Index > IND(IPTR(I + Offset)).Index THEN
SWAP IPTR(I), IPTR(I + Offset)
Switch = I
END IF
NEXT I
Limit = Switch
LOOP WHILE Switch
Offset = Offset \ 2
PRINT Offset; " "
LOOP
END SUB